home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / qbtiny.exe / MWORD.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-07-15  |  5.7 KB  |  208 lines
  1.    DECLARE SUB XQPrint (St$, BYVAL Y%, BYVAL X%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  2.    DECLARE SUB Delay18th (BYVAL M%)
  3.    DECLARE FUNCTION Rand% (BYVAL Range%)
  4.  
  5.    DECLARE SUB GetDisplay (Adapter%, Mono%)
  6.  
  7.    DEFINT A-Z
  8.  
  9.    GetDisplay Adapter, Mono
  10.    IF Adapter < 3 THEN
  11.       PRINT "Sorry, you must have a color adapter (CGA, EGA, MCGA, or VGA) to run MWORD."
  12.       END
  13.    END IF
  14.  
  15.    SCREEN 0, , 0, 0
  16.  
  17.    DEF FNR (X) = RAND(X) + 1
  18.  
  19.    DIM X(1 TO 255), Y(1 TO 255)
  20.    DIM XVector(1 TO 255), YVector(1 TO 255)
  21.    DIM XPos(1 TO 255) AS STRING * 40, YPos(1 TO 255) AS STRING * 40
  22.    DIM Colour(1 TO 255), RevColour(1 TO 255)
  23.  
  24.    Cmd$ = UCASE$(LTRIM$(RTRIM$(COMMAND$)))
  25.  
  26.    IF LEN(Cmd$) = 0 THEN
  27.       PRINT "MultiWord 1.2  Copyright (c) 1992  Thomas G. Hanlin III"
  28.       PRINT
  29.       PRINT "Syntax:"
  30.       PRINT "   MWORD [number of words] {/Wword} {/Ddelay} {/B} {/C} {/F}"
  31.       PRINT
  32.       PRINT "Use /B for monochrome systems."
  33.       PRINT "Use /C for crawling words or /F for flying words."
  34.       PRINT
  35.       PRINT "The /W switch specifies a word (default FOO)."
  36.       PRINT "The /D switch specifies a delay in 1/18th seconds (default 1)."
  37.       END
  38.    END IF
  39.  
  40.    tmp = INSTR(Cmd$, "/B")
  41.    IF tmp THEN
  42.       Mono = -1
  43.       Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2)))
  44.    END IF
  45.  
  46.    tmp = INSTR(Cmd$, "/C")
  47.    IF tmp THEN
  48.       Crawling = -1
  49.       Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2)))
  50.    END IF
  51.  
  52.    tmp = INSTR(Cmd$, "/F")
  53.    IF tmp THEN
  54.       Flying = -1
  55.       Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2)))
  56.    END IF
  57.  
  58.    IF NOT (Crawling OR Flying) THEN Flying = -1
  59.  
  60.    tmp = INSTR(Cmd$, "/W")
  61.    IF tmp THEN
  62.       tmp1 = INSTR(tmp, Cmd$, " ")
  63.       IF tmp1 = 0 THEN tmp1 = LEN(Cmd$) + 1
  64.       Word$ = LEFT$(LTRIM$(RTRIM$(MID$(Cmd$, tmp + 2, tmp1 - tmp - 2))), 40)
  65.       Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp1 + 1)))
  66.    END IF
  67.    IF LEN(Word$) = 0 THEN
  68.       Word$ = "Foo"
  69.    END IF
  70.  
  71.    WordLen = LEN(Word$)
  72.  
  73.    tmp = INSTR(Cmd$, "/D")
  74.    IF tmp THEN
  75.       Num$ = ""
  76.       c = tmp + 2
  77.       DO WHILE c <= LEN(Cmd$)
  78.          IF INSTR("0123456789", MID$(Cmd$, c, 1)) THEN
  79.             Num$ = Num$ + MID$(Cmd$, c, 1)
  80.             c = c + 1
  81.          ELSE
  82.             c = LEN(Cmd$) + 1
  83.          END IF
  84.       LOOP
  85.       IF LEN(Num$) > 0 AND LEN(Num$) < 3 THEN Waits = VAL(Num$)
  86.       IF Waits < 0 THEN
  87.          Waits = 0
  88.       ELSEIF Waits > 18 THEN
  89.          Waits = 18
  90.       END IF
  91.       Cmd$ = LTRIM$(RTRIM$(LEFT$(Cmd$, tmp - 1) + MID$(Cmd$, tmp + 2 + LEN(Num$))))
  92.    ELSE
  93.       Waits = 1
  94.    END IF
  95.  
  96.    Capybara = VAL(Cmd$)
  97.    IF Capybara < 1 THEN
  98.       Capybara = 1              ' the loneliest number
  99.    ELSEIF Capybara > 255 THEN
  100.       Capybara = 255            ' an orgy
  101.    END IF
  102.  
  103.    PCOPY 0, 1
  104.    APage = 1
  105.  
  106.    FOR Banana = 1 TO Capybara
  107.       X(Banana) = FNR(81 - WordLen)
  108.       Y(Banana) = FNR(25)
  109.       XPos(Banana) = STRING$(WordLen, X(Banana))
  110.       YPos(Banana) = STRING$(WordLen, Y(Banana))
  111.       XVector(Banana) = 2 - FNR(3)
  112.       YVector(Banana) = 2 - FNR(3)
  113.       IF Mono THEN
  114.          Colour(Banana) = 7
  115.          RevColour(Banana) = &H70
  116.       ELSE
  117.          Colour(Banana) = FNR(15)
  118.          RevColour(Banana) = Colour(Banana) * 16 AND &H70
  119.       END IF
  120.    NEXT Banana
  121.  
  122.    DO
  123.       IF Crawling THEN GOSUB CrawlWrite
  124.       IF Flying THEN GOSUB FlyWrite
  125.       APage = 1 - APage
  126.       VPage = 1 - VPage
  127.       SCREEN 0, , 0, VPage
  128.       PCOPY VPage, APage
  129.       Delay18th Waits
  130.       IF Flying THEN GOSUB FlyClear
  131.       IF Crawling THEN GOSUB CrawlClear
  132.    LOOP WHILE INKEY$ = ""
  133.  
  134.    SCREEN 0, , 0, 0
  135.    CLS
  136.  
  137.    END
  138.  
  139.  
  140. ' ------------------- words fly across the screen ----------------------------
  141.  
  142.  
  143. FlyWrite:
  144.    FOR Banana = 1 TO Capybara
  145.       XQPrint Word$, Y(Banana), X(Banana), Colour(Banana), APage, 1
  146.    NEXT Banana
  147.    RETURN
  148.  
  149. FlyClear:
  150.    FOR Banana = 1 TO Capybara
  151.       XQPrint SPACE$(WordLen), Y(Banana), X(Banana), 7, APage, 1
  152.       X(Banana) = X(Banana) + XVector(Banana)
  153.       IF X(Banana) > 80 THEN
  154.          X(Banana) = 1
  155.       ELSEIF X(Banana) < 1 THEN
  156.          X(Banana) = 80
  157.       END IF
  158.       Y(Banana) = Y(Banana) + YVector(Banana)
  159.       IF Y(Banana) > 25 THEN
  160.          Y(Banana) = 1
  161.       ELSEIF Y(Banana) < 1 THEN
  162.          Y(Banana) = 25
  163.       END IF
  164.       IF FNR(20) = 1 THEN XVector(Banana) = 2 - FNR(3)
  165.       IF FNR(20) = 1 THEN YVector(Banana) = 2 - FNR(3)
  166.    NEXT Banana
  167.    RETURN
  168.  
  169.  
  170. ' ------------------- words crawl across the screen --------------------------
  171.  
  172.  
  173. CrawlWrite:
  174.    FOR Banana = 1 TO Capybara
  175.       FOR Indian = 1 TO WordLen
  176.          Y = ASC(MID$(YPos(Banana), Indian, 1))
  177.          X = ASC(MID$(XPos(Banana), Indian, 1))
  178.          Ch$ = MID$(Word$, Indian, 1)
  179.          XQPrint Ch$, Y, X, RevColour(Banana), APage,1
  180.       NEXT Indian
  181.    NEXT Banana
  182.    RETURN
  183.  
  184. CrawlClear:
  185.    Delay18th 1
  186.    FOR Banana = 1 TO Capybara
  187.       Y = ASC(MID$(YPos(Banana), WordLen, 1))
  188.       X = ASC(MID$(XPos(Banana), WordLen, 1))
  189.       XQPrint " ", Y, X, 7, APage, 1
  190.       X(Banana) = X(Banana) + XVector(Banana)
  191.       IF X(Banana) > 81 - WordLen THEN
  192.          X(Banana) = 1
  193.       ELSEIF X(Banana) < 1 THEN
  194.          X(Banana) = 81 - WordLen
  195.       END IF
  196.       Y(Banana) = Y(Banana) + YVector(Banana)
  197.       IF Y(Banana) > 25 THEN
  198.          Y(Banana) = 1
  199.       ELSEIF Y(Banana) < 1 THEN
  200.          Y(Banana) = 25
  201.       END IF
  202.       MID$(YPos(Banana), 1, WordLen) = CHR$(Y(Banana)) + LEFT$(YPos(Banana), WordLen - 1)
  203.       MID$(XPos(Banana), 1, WordLen) = CHR$(X(Banana)) + LEFT$(XPos(Banana), WordLen - 1)
  204.       IF FNR(20) = 1 THEN XVector(Banana) = 2 - FNR(3)
  205.       IF FNR(20) = 1 THEN YVector(Banana) = 2 - FNR(3)
  206.    NEXT Banana
  207.    RETURN
  208.